package Data::Form;

use strict;
use warnings;
use Data::Form::Field;
use Carp;
use Data::Dumper;

use vars '$VERSION';

$VERSION = '0.09';

use base qw/Class::Accessor::Assert/;

__PACKAGE__->mk_accessors(qw/ title name valid _field_pos @fields=Data::Form::Field
							  @_extraction_profiles extra @validators/);


sub new {
	my $class	= shift;
	my %args	= @_;
	
	my $self = bless {}, $class;
	#TODO should probably call SUPER::new here
	$self->add_fields_hrefs( @{$args{fields}} );
	$self->validators( @{$args{validators}} ) if $args{validators};
	$self->_extraction_profiles( @{$args{profiles}} ) if $args{profiles};
	return $self;	
}


sub add_form {
	my $self = shift;
	my $i = 0;
	for my $form (@_){
		$self->forms_push($form);
  		$self->_forms_pos_push( $form->name => $i++ );
  	}
}

sub add_fields_hrefs
{
  my $self = shift;
  my $i = 0;
  
  for (@_)
  {
	my $field = Data::Form::Field->make_field( %$_ );
 	$self->fields_push($field);
  	$self->{_field_pos}{ $field->name } = $i++;
  }
}

sub add_fields
{
	my $self = shift;
	my $i = 0;
	
	while (@_)
	{
		my $name = shift;
		my $href = shift;
		$href->{name} = $name unless defined $href->{name};
		my $field = Data::Form::Field->make_field(%$href);
  		$self->fields_push($field);
  		$self->{_field_pos}{ $field->name } = $i++;
	}
}

sub fill_in
{
	my $self   = shift;
	my %values = @_;
	
	my $num_fields   = 0;# + $self->fields;
	my $valid_fields = 0;

	for my $f ( $self->fields )
	{
		++$num_fields;
		$f->fill_in( $values{ $f->name } );
		$valid_fields++ if $f->valid;
		
		delete $values{ $f->name };
	}

	$valid_fields == $num_fields ? $self->valid(1) : $self->valid(0) ;
	
	if ( $self->valid and $self->validators){
		$self->validate;
	}
	

	$self->extra( \%values );
	return $self->valid;
}



sub pre_fill
{
	my $self   = shift;
	my %values = @_;
	
	my $num_fields   = 0;# + $self->fields;

	for my $f ( $self->fields )
	{
		$f->pre_fill( $values{ $f->name } ) if $values{ $f->name };
		$num_fields++;
	}

	return $num_fields;
}

sub field 
{
	my $self       	= shift;
	my $field_name = shift;
	
	for ($self->fields){
		return $_ if $_->name eq $field_name;
	}
}

sub as_hash 
{
	my $self   = shift;
	my $hashref = {};

	foreach my $f ( $self->fields ){
		$hashref->{ $f->name } = $f->value;
	}

	return wantarray ? %$hashref : $hashref;
}

sub extract {
	my $self	= shift;
	
	return undef unless $self->valid;
	#TODO validate field names in profile at init time
	my $profilename	= shift;
	my %profiles	= $self->_extraction_profiles;
	#print Dumper \%profiles;
	
	defined  $profiles{$profilename} or croak "'$profilename' doesn't exist as an extraction profile in this form\n";
	my $profile     = $profiles{$profilename};
	
	my $fieldvalues = $self->as_hash;
	
	my $extracted;
	
	foreach my $field_name ( keys %$profile ){
		$extracted->{ $profile->{$field_name}  } = $self->field($field_name)->value;
	}

	return wantarray ? %$extracted : $extracted;
}

sub validate {
    my $self = shift;

    # Do custom validation routines
   	#validators => [
	#{
	#	fields		=> [qw/ password confirmpassword /],
	#	error		=> 'PASSWORDS_MUST_MATCH',
	#	gets_error => 'password',		
	#	test			=> sub { $_[0] eq $_[1] }
	#},
    
    my ($errors, $validators);
    for my $val ( $self->validators ) 
    {
		my $test_type = ref($val->{test});
		if ( $test_type ne 'CODE')
		{
			#TODO put in a stricter check in new and maybe build a sub and install it
			#TODO check that fields are valid field names
			carp "Value 'test' param for a validator must be a CODE ref\n";
			next;
		} 
		$validators++;		
	
		my @fields;
		push @fields, $self->field($_)->value for @{$val->{fields}};

		my $error_target = $self->field( $val->{gets_error});
		{
		no strict 'refs';
		# perform our test
		unless ( $val->{test}->(@fields) )
		{
			$error_target->valid(0);
			$error_target->add_errors($val->{error}) ;
			$errors++;
		}
		}
		 
	}

    

    # No errors so it must be valid
    $self->valid(0) if $errors;
    $self->valid;
}

sub _check_value_code {
    my ( $code, @data ) = @_;
    my $i;

    for (@data) {
        $i++ if $code->($_);
    }

    return $i == @data ? 1 : 0;

}


1;

__END__
=head1 NAME

Data::Form - Form and data structure validation

=head1 SYNOPSIS

	use Data::Form;

    my $form = Data::Form->new(
    			username => { required => 1 },
    			password => { required => 1 }
    );

    $form->fill_in( %args );

    if ( $form->is_valid() ) {
        # logging in ...
    } 



=head1 A MORE DETAILED EXAMPLE

	use Data::Form;

	my $form = Data::Form->new(
        fields => [
			{
				name       => 'userid',
	   			required   => 1,
	   			validators => { 'ONLY_WORD_CHARS' => sub {shift;/^(\w|\s)+$/ ? 1 : 0 } },
			},
			{
				name        => 'name',
	   			validators  => { 'ONLY_WORD_CHARS' => sub {shift;/^(\w|\s)+$/ ? 1 : 0 } },
			},
			{
				name       => 'password',
	   			required   => 1,
	   			type       => 'My::Fields::PasswordType'
			},
			{
				name       => 'confirmpassword',
				required   => 1,
				type       => 'My::Fields::PasswordType'
			}
			],
        validators => [
			{
				fields		=> [qw/ password confirmpassword /],
				error		=> 'PASSWORDS_MUST_MATCH',
				gets_error => 'password',		
				test			=> sub { $_[0] eq $_[1] }
			},
			]
	);

	# ... show the form
	
	%data = (		userid          => 'fred.flintstone',
                    name            => 'Fred',
                    password        => 'Wilma!'
                    confirmpassword => 'Betty!');

    $form->fill_in( %data );
    
    unless ( $form->is_valid ){
    	for ($form->fields){
    		printf("%s has the error %s\n", $_->name, $_->error) unless $_->is_valid;
    	}
    	exit;
    }




=head1 DESCRIPTION

This is a class designed to model forms and form-like things. The goal is to build a model  
to aid in determining whether a given set of input constitutes a valid state of the "form."

The list of form-like things includes any user interface that asks a user questions and expects  
to process the answers: CGI forms, configuration files, a list of prompts for an interactive command line,  
YAML file or a plain old hashref.

Forms consist of fields where the field data requires validation before being accepted. 
Data often consists of different types such as email addresses, dates, ranges.
And the questions asked of the user have different attributes 
( is the answer required, is the answer in a limited set, can it be answered multiple times?) 

This class does not generate HTML or any other UI. It just models the behaivours and data of forms.

=head1 SEE ALSO

Similar Modules include L<Data::FormValidator>, L<Data::Form::Elements> and L<Form::Processor> 

=head1 AUTHOR

Clayton Scott, E<clscott@cpan.org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Clayton Scott

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.


=cut